home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRIC / DSPICE0S.ZIP / acdcmp.c < prev    next >
C/C++ Source or Header  |  1992-11-22  |  9KB  |  260 lines
  1. /* acdcmp.f -- translated by f2c (version of 3 February 1990  3:36:42).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Common Block Declarations */
  9.  
  10. struct {
  11.     integer ielmnt, isbckt, nsbckt, iunsat, nunsat, itemps, numtem, isens, 
  12.         nsens, ifour, nfour, ifield, icode, idelim, icolum, insize, 
  13.         junode, lsbkpt, numbkp, iorder, jmnode, iur, iuc, ilc, ilr, 
  14.         numoff, isr, nmoffc, iseq, iseq1, neqn, nodevs, ndiag, iswap, 
  15.         iequa, macins, lvnim1, lx0, lvn, lynl, lyu, lyl, lx1, lx2, lx3, 
  16.         lx4, lx5, lx6, lx7, ld0, ld1, ltd, imynl, imvn, lcvn, nsnod, 
  17.         nsmat, nsval, icnod, icmat, icval, loutpt, lpol, lzer, irswpf, 
  18.         irswpr, icswpf, icswpr, irpt, jcpt, irowno, jcolno, nttbr, nttar, 
  19.         lvntmp;
  20. } tabinf_;
  21.  
  22. #define tabinf_1 tabinf_
  23.  
  24. struct {
  25.     integer locate[50], jelcnt[50], nunods, ncnods, numnod, nstop, nut, nlt, 
  26.         nxtrm, ndist, ntlin, ibr, numvs, numalt, numcyc;
  27. } cirdat_;
  28.  
  29. #define cirdat_1 cirdat_
  30.  
  31. struct {
  32.     integer iprnta, iprntl, iprntm, iprntn, iprnto, limtim, limpts, lvlcod, 
  33.         lvltim, itl1, itl2, itl3, itl4, itl5, itl6, igoof, nogo, keof;
  34. } flags_;
  35.  
  36. #define flags_1 flags_
  37.  
  38. struct {
  39.     doublereal twopi, xlog2, xlog10, root2, rad, boltz, charge, ctok, gmin, 
  40.         reltol, abstol, vntol, trtol, chgtol, eps0, epssil, epsox, pivtol,
  41.          pivrel;
  42. } knstnt_;
  43.  
  44. #define knstnt_1 knstnt_
  45.  
  46. struct {
  47.     doublereal value[200000];
  48. } blank_;
  49.  
  50. #define blank_1 blank_
  51.  
  52. struct {
  53.     doublereal omega, time, delta, delold[7], ag[7], vt, xni, egfet, xmu, 
  54.         sfactr;
  55.     integer mode, modedc, icalc, initf, method, iord, maxord, noncon, iterno, 
  56.         itemno, nosolv, modac, ipiv, ivmflg, ipostp, iscrch, iofile;
  57. } status_;
  58.  
  59. #define status_1 status_
  60.  
  61. /* Table of constant values */
  62.  
  63. static integer c__1 = 1;
  64.  
  65. /*<       subroutine acdcmp >*/
  66. /* Subroutine */ int acdcmp_()
  67. {
  68.     /* Format strings */
  69.     static char fmt_11[] = "(\0020\002,\002 underflow occured at step n= \
  70. \002,i5)";
  71.  
  72.     /* System generated locals */
  73.     doublereal d_1, d_2;
  74.  
  75.     /* Builtin functions */
  76.     integer s_wsfe(), do_fio(), e_wsfe();
  77.  
  78.     /* Local variables */
  79.     static integer locc;
  80.     extern /* Subroutine */ int cdiv_();
  81.     static integer locr, nxti, nxtj, i, j;
  82.     static doublereal gdiag;
  83.     static integer n, locij;
  84.     static doublereal ximag;
  85.     static integer locnn;
  86.     static doublereal xreal;
  87.     static integer n1, n2;
  88.     extern integer indxx_();
  89.     extern /* Subroutine */ int cmult_();
  90. #define nodplc ((integer *)&blank_1)
  91. #define cvalue ((complex *)&blank_1)
  92.  
  93.     /* Fortran I/O blocks */
  94.     static cilist io__10 = { 0, 0, 0, fmt_11, 0 };
  95.  
  96.  
  97. /*<       implicit double precision (a-h,o-z) >*/
  98.  
  99. /*     this routine performs an lu factorization of the circuit equation 
  100. */
  101. /* coefficient matrix. */
  102.  
  103. /* spice version 2g.6  sccsid=tabinf 3/15/83 */
  104. /*<       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem, >*/
  105. /*<      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize, >*/
  106. /*<      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr, >*/
  107. /*<      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1, >*/
  108. /*<      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd, >*/
  109. /*<      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval, >*/
  110. /*<      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt, >*/
  111. /*<      7   irowno,jcolno,nttbr,nttar,lvntmp >*/
  112. /* spice version 2g.6  sccsid=cirdat 3/15/83 */
  113. /*<       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop, >*/
  114. /*<      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc >*/
  115. /* spice version 2g.6  sccsid=flags 3/15/83 */
  116. /*<       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts, >*/
  117. /*<      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof >*/
  118. /* spice version 2g.6  sccsid=knstnt 3/15/83 */
  119. /*<       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok, >*/
  120. /*<      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox, >*/
  121. /*<      2   pivtol,pivrel >*/
  122. /* spice version 2g.6  sccsid=blank 3/15/83 */
  123. /*<       common /blank/ value(200000) >*/
  124. /* spice version 2g.6  sccsid=status 3/15/83 */
  125. /*<       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet, >*/
  126. /*<      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon, >*/
  127. /*<      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile >*/
  128. /*<       integer nodplc(64) >*/
  129. /*<       complex cvalue(32) >*/
  130. /*<       equivalence (value(1),nodplc(1),cvalue(1)) >*/
  131.  
  132. /*<       n=1 >*/
  133.     n = 1;
  134. /*<    10 n=n+1 >*/
  135. L10:
  136.     ++n;
  137. /*<       nxti=n >*/
  138.     nxti = n;
  139. /*<       nxtj=n >*/
  140.     nxtj = n;
  141.  
  142. /*     calculate contribution from (nxti,nxtj) */
  143.  
  144. /*<       if (n.ge.nstop) return >*/
  145.     if (n >= cirdat_1.nstop) {
  146.     return 0;
  147.     }
  148. /*<       n1=nodplc(irswpf+nxti) >*/
  149.     n1 = nodplc[tabinf_1.irswpf + nxti - 1];
  150. /*<       n2=nodplc(icswpf+nxtj) >*/
  151.     n2 = nodplc[tabinf_1.icswpf + nxtj - 1];
  152. /*<       locnn=indxx(n1,n2) >*/
  153.     locnn = indxx_(&n1, &n2);
  154. /*<       gdiag=dabs(value(lynl+locnn))+dabs(value(imynl+locnn)) >*/
  155.     gdiag = (d_1 = blank_1.value[tabinf_1.lynl + locnn - 1], abs(d_1)) + (d_2 
  156.         = blank_1.value[tabinf_1.imynl + locnn - 1], abs(d_2));
  157. /*<       if (gdiag.ge.pivtol) go to 20 >*/
  158.     if (gdiag >= knstnt_1.pivtol) {
  159.     goto L20;
  160.     }
  161. /*<       value(lynl+locnn)=pivtol >*/
  162.     blank_1.value[tabinf_1.lynl + locnn - 1] = knstnt_1.pivtol;
  163. /*<       value(imynl+locnn)=0.0d0 >*/
  164.     blank_1.value[tabinf_1.imynl + locnn - 1] = 0.;
  165. /*<       write(iofile,11) n >*/
  166.     io__10.ciunit = status_1.iofile;
  167.     s_wsfe(&io__10);
  168.     do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
  169.     e_wsfe();
  170. /*<    11 format(1h0,' underflow occured at step n= ',i5) >*/
  171.  
  172. /*     down col j */
  173.  
  174. /*<    20 locr=nodplc(irpt+locnn) >*/
  175. L20:
  176.     locr = nodplc[tabinf_1.irpt + locnn - 1];
  177. /*<    25 if (locr.eq.0) go to 10 >*/
  178. L25:
  179.     if (locr == 0) {
  180.     goto L10;
  181.     }
  182. /*<       i=nodplc(irowno+locr) >*/
  183.     i = nodplc[tabinf_1.irowno + locr - 1];
  184. /*<       call cdiv(value(lynl+locr),value(imynl+locr),value(lynl+locnn), >*/
  185. /*<      1     value(imynl+locnn),value(lynl+locr),value(imynl+locr)) >*/
  186.     cdiv_(&blank_1.value[tabinf_1.lynl + locr - 1], &blank_1.value[
  187.         tabinf_1.imynl + locr - 1], &blank_1.value[tabinf_1.lynl + locnn 
  188.         - 1], &blank_1.value[tabinf_1.imynl + locnn - 1], &blank_1.value[
  189.         tabinf_1.lynl + locr - 1], &blank_1.value[tabinf_1.imynl + locr - 
  190.         1]);
  191. /*<       locc=nodplc(jcpt+locnn) >*/
  192.     locc = nodplc[tabinf_1.jcpt + locnn - 1];
  193.  
  194. /*     for each element look up row nxti */
  195.  
  196. /*<    30 if (locc.eq.0) go to 70 >*/
  197. L30:
  198.     if (locc == 0) {
  199.     goto L70;
  200.     }
  201. /*<       j=nodplc(jcolno+locc) >*/
  202.     j = nodplc[tabinf_1.jcolno + locc - 1];
  203.  
  204. /*     locate element (i,j) */
  205.  
  206. /*<    35 if (j.lt.i) go to 45 >*/
  207. /* L35: */
  208.     if (j < i) {
  209.     goto L45;
  210.     }
  211. /*<       locij=locc >*/
  212.     locij = locc;
  213. /*<    40 locij=nodplc(irpt+locij) >*/
  214. L40:
  215.     locij = nodplc[tabinf_1.irpt + locij - 1];
  216. /*<       if (nodplc(irowno+locij).eq.i) go to 55 >*/
  217.     if (nodplc[tabinf_1.irowno + locij - 1] == i) {
  218.     goto L55;
  219.     }
  220. /*<       go to 40 >*/
  221.     goto L40;
  222. /*<    45 locij=locr >*/
  223. L45:
  224.     locij = locr;
  225. /*<    50 locij=nodplc(jcpt+locij) >*/
  226. L50:
  227.     locij = nodplc[tabinf_1.jcpt + locij - 1];
  228. /*<       if (nodplc(jcolno+locij).eq.j) go to 55 >*/
  229.     if (nodplc[tabinf_1.jcolno + locij - 1] == j) {
  230.     goto L55;
  231.     }
  232. /*<       go to 50 >*/
  233.     goto L50;
  234. /*<    55 call cmult(value(lynl+locc),value(imynl+locc), >*/
  235. /*<      1     value(lynl+locr),value(imynl+locr),xreal,ximag) >*/
  236. L55:
  237.     cmult_(&blank_1.value[tabinf_1.lynl + locc - 1], &blank_1.value[
  238.         tabinf_1.imynl + locc - 1], &blank_1.value[tabinf_1.lynl + locr - 
  239.         1], &blank_1.value[tabinf_1.imynl + locr - 1], &xreal, &ximag);
  240. /*<       value(lynl+locij)=value(lynl+locij)-xreal >*/
  241.     blank_1.value[tabinf_1.lynl + locij - 1] -= xreal;
  242. /*<       value(imynl+locij)=value(imynl+locij)-ximag >*/
  243.     blank_1.value[tabinf_1.imynl + locij - 1] -= ximag;
  244. /*<       locc=nodplc(jcpt+locc) >*/
  245.     locc = nodplc[tabinf_1.jcpt + locc - 1];
  246. /*<       go to 30 >*/
  247.     goto L30;
  248. /*<    70 locr=nodplc(irpt+locr) >*/
  249. L70:
  250.     locr = nodplc[tabinf_1.irpt + locr - 1];
  251. /*<       go to 25 >*/
  252.     goto L25;
  253. /*<       end >*/
  254. } /* acdcmp_ */
  255.  
  256. #undef cvalue
  257. #undef nodplc
  258.  
  259.  
  260.